home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / you-075a.lha / you-075a / chars.c < prev    next >
C/C++ Source or Header  |  1992-06-18  |  20KB  |  698 lines
  1. /* ******************************************************************** */
  2. /*  chars.c          Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* Basic character, string and symbol functions                */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * $Id: chars.c,v 1.8 1992/05/19 11:15:39 pab Exp $
  9.  *
  10.  * $Log: chars.c,v $
  11.  * Revision 1.8  1992/05/19  11:15:39  pab
  12.  * string-ref (int) added
  13.  *
  14.  * Revision 1.7  1992/04/26  20:59:29  pab
  15.  * symbol fixes(symbol-name)
  16.  *
  17.  * Revision 1.6  1992/01/29  13:38:48  pab
  18.  * sysV fixes
  19.  *
  20.  * Revision 1.5  1992/01/09  22:28:45  pab
  21.  * Fixed for low tag ints
  22.  *
  23.  * Revision 1.4  1991/12/22  15:13:55  pab
  24.  * Xmas revision
  25.  *
  26.  * Revision 1.3  1991/11/15  13:44:28  pab
  27.  * copyalloc rev 0.01
  28.  *
  29.  * Revision 1.2  1991/09/11  12:07:04  pab
  30.  * 11/9/91 First Alpha release of modified system
  31.  *
  32.  * Revision 1.1  1991/08/12  16:49:30  pab
  33.  * Initial revision
  34.  *
  35.  * Revision 1.4  1991/02/13  18:18:07  kjp
  36.  * Symbol and string allocation corrections + RCS log header.
  37.  *
  38.  */
  39.  
  40. /*
  41.  * Change Log:
  42.  *   Version 1, May 1989
  43.  *    Checked for GC protection - JPff
  44.  */
  45.  
  46. #include <string.h>
  47. #include <ctype.h>
  48. #include "funcalls.h"
  49. #include "defs.h"
  50. #include "structs.h"
  51. #include "error.h"
  52. #include "global.h"
  53.  
  54. #include "modboot.h"
  55. #include "symboot.h"
  56. #include "calls.h"
  57.  
  58. /* These functions are taken from the CHARACTERS AND STRINGS section */
  59.  
  60. EUFUN_1( Fn_characterp, form)
  61. {
  62.   return (is_char(form) ? lisptrue : nil);
  63. }
  64. EUFUN_CLOSE
  65.  
  66. EUFUN_1( Fn_int2char, form)
  67. {
  68.   while (typeof(form)!=TYPE_INT)
  69.     form = CallError(stacktop,
  70.           "Not an integer in integer-to-character",form,CONTINUABLE);
  71.   return allocate_char(stackbase, intval(form));
  72. }
  73. EUFUN_CLOSE
  74.  
  75. EUFUN_1( Fn_char2int, form)
  76. {
  77.   while (!is_char(form))
  78.     form = CallError(stacktop,
  79.          "Not a character in character-to-integer",form,CONTINUABLE);
  80.   return allocate_integer(stackbase, (int)(form->CHAR).code);
  81. }
  82. EUFUN_CLOSE
  83.  
  84. /* ******************************** */
  85. /* Latin-character-operators module */
  86. /* ******************************** */
  87.  
  88. EUFUN_1( Fn_charalphap, form)
  89. {
  90.   while (!is_char(form))
  91.     form = CallError(stacktop,"Not a character in char-alphabetic-p",form,CONTINUABLE);
  92.   return (isalpha((form->CHAR).code) ? lisptrue : nil);
  93. }
  94. EUFUN_CLOSE
  95.  
  96. EUFUN_1( Fn_charnump, form)
  97. {
  98.   while (!is_char(form))
  99.     form = CallError(stacktop,"Not a character in char-numeric-p",form,CONTINUABLE);
  100.   return (isdigit((form->CHAR).code) ? lisptrue : nil);
  101. }
  102. EUFUN_CLOSE
  103.  
  104. EUFUN_1( Fn_charwhitep, form)
  105. {
  106.   while (!is_char(form))
  107.     form = CallError(stacktop,"Not a character in char-whitespace-p",form,CONTINUABLE);
  108.   return (isspace((form->CHAR).code) ? lisptrue : nil);
  109. }
  110. EUFUN_CLOSE
  111.  
  112. EUFUN_1( Fn_charpuncp, form)
  113. {
  114.   while (!is_char(form))
  115.     form = CallError(stacktop,"Not a character in char-punctuation-p",form,CONTINUABLE);
  116.   return (ispunct((form->CHAR).code) ? lisptrue : nil);
  117. }
  118. EUFUN_CLOSE
  119.  
  120. EUFUN_1( Fn_charotherp, form)
  121. {
  122.   while (!is_char(form))
  123.     form = CallError(stacktop,"Not a character in char-other-p",form,CONTINUABLE);
  124.   return (isgraph((form->CHAR).code) ? lisptrue : nil);
  125. }
  126. EUFUN_CLOSE
  127.  
  128. EUFUN_1( Fn_charupperp, form)
  129. {
  130.   while (!is_char(form))
  131.     form = CallError(stacktop,"Not a character in char-upper-case-p",form,CONTINUABLE);
  132.   return (isupper((form->CHAR).code) ? lisptrue : nil);
  133. }
  134. EUFUN_CLOSE
  135.  
  136. EUFUN_1( Fn_charlowerp, form)
  137. {
  138.   while (!is_char(form))
  139.     form = CallError(stacktop,"Not a character in char-lower-case-p",form,CONTINUABLE);
  140.   return (islower((form->CHAR).code) ? lisptrue : nil);
  141. }
  142. EUFUN_CLOSE
  143.  
  144. EUFUN_1( Fn_charupper, form)
  145. {
  146.   while (!is_char(form))
  147.     form = CallError(stacktop,"Not an character in char-upcase",form,CONTINUABLE);
  148.   return allocate_char(stackbase, toupper(intval(form)));
  149. }
  150. EUFUN_CLOSE
  151.  
  152. EUFUN_1( Fn_charlower, form)
  153. {
  154.   while (!is_char(form))
  155.     form = CallError(stacktop,"Not an character in char-downcase",form,CONTINUABLE);
  156.   return allocate_char(stackbase, tolower(intval(form)));
  157. }
  158. EUFUN_CLOSE
  159.  
  160. /* ************************************ */
  161. /* Universal-character-operators module */
  162. /* ************************************ */
  163.  
  164. EUFUN_2( Fn_chareq, form1, form2)
  165. {
  166.   while (!is_char(form1))
  167.     form1 = CallError(stacktop,"Not a character in char-equal",form1,CONTINUABLE);
  168.   while (!is_char(form2))
  169.     form2 = CallError(stacktop,"Not a character in char-equal",form2,CONTINUABLE);
  170.   return ((form1->CHAR).code == (form2->CHAR).code ? lisptrue : nil);
  171. }
  172. EUFUN_CLOSE
  173.  
  174. EUFUN_2( Fn_charls, form1, form2)
  175. {
  176.   while (!is_char(form1))
  177.     form1 = CallError(stacktop,"Not a character in char<",form1,CONTINUABLE);
  178.   while (!is_char(form2))
  179.     form2 = CallError(stacktop,"Not a character in char<",form2,CONTINUABLE);
  180.   return ((form1->CHAR).code < (form2->CHAR).code ? lisptrue : nil);
  181. }
  182. EUFUN_CLOSE
  183.  
  184. EUFUN_2( Fn_chargt, form1, form2)
  185. {
  186.   while (!is_char(form1))
  187.     form1 = CallError(stacktop,"Not a character in char>",form1,CONTINUABLE);
  188.   while (!is_char(form2))
  189.     form2 = CallError(stacktop,"Not a character in char>",form2,CONTINUABLE);
  190.   return ((form1->CHAR).code > (form2->CHAR).code ? lisptrue : nil);
  191. }
  192. EUFUN_CLOSE
  193.  
  194. EUFUN_2( Fn_charle, form1, form2)
  195. {
  196.   while (!is_char(form1))
  197.     form1 = CallError(stacktop,"Not a character in char<=",form1,CONTINUABLE);
  198.   while (!is_char(form2))
  199.     form2 = CallError(stacktop,"Not a character in char<=",form2,CONTINUABLE);
  200.   return ((form1->CHAR).code <= (form2->CHAR).code ? lisptrue : nil);
  201. }
  202. EUFUN_CLOSE
  203.  
  204. EUFUN_2( Fn_charge, form1, form2)
  205. {
  206.   while (!is_char(form1))
  207.     form1 = CallError(stacktop,"Not a character in char>=",form1,CONTINUABLE);
  208.   while (!is_char(form2))
  209.     form2 = CallError(stacktop,"Not a character in char>=",form2,CONTINUABLE);
  210.   return ((form1->CHAR).code >= (form2->CHAR).code ? lisptrue : nil);
  211. }
  212. EUFUN_CLOSE
  213.  
  214. /* STRINGS */
  215.  
  216. EUFUN_1( Fn_stringp, form)
  217. {
  218.   return (is_string(form) ? lisptrue : nil);
  219. }
  220. EUFUN_CLOSE
  221.  
  222. EUFUN_1( Fn_string_copy, form)
  223. {
  224.   LispObject ans;
  225.   while (!is_string(form)) 
  226.     form = CallError(stacktop,"Not a string in string-copy",form,CONTINUABLE);
  227.   ans = allocate_string(stackbase,
  228.             stringof(form),strlen(stringof(form)));
  229.   return ans;
  230. }
  231. EUFUN_CLOSE
  232.  
  233. EUFUN_1( Fn_string_length, form)
  234. {
  235.   while (!is_string(form))
  236.     form = CallError(stacktop,"Not a string in string-length",form,CONTINUABLE);
  237.   return allocate_integer(stackbase, strlen(stringof(form)));
  238. }
  239. EUFUN_CLOSE
  240.  
  241. EUFUN_2( Fn_sref, form, off)
  242. {
  243.   while (!is_string(form))
  244.     form = CallError(stacktop,"Not a string in string-ref",form,CONTINUABLE);
  245.   while (typeof(off)!=TYPE_INT)
  246.     off = CallError(stacktop,"Not an integer in string-ref",form,CONTINUABLE);
  247.   return allocate_char(stackbase, (stringof(form))[intval(off)]);
  248. }
  249. EUFUN_CLOSE
  250.  
  251. EUFUN_3( Fn_sref_setter, form, off, ch)
  252. {
  253.   while (!is_string(form))
  254.     form = CallError(stacktop,"Not a string in set-string-ref",form,CONTINUABLE);
  255.   while (typeof(off)!=TYPE_INT)
  256.     off = CallError(stacktop,"Not an integer in set-string-ref",form,CONTINUABLE);
  257.   while (!is_char(ch))
  258.     off = CallError(stacktop,"Not an character in set-string-ref",form,CONTINUABLE);
  259.   stringof(form)[intval(off)] = (ch->CHAR).code;
  260.   return nil;
  261. }
  262. EUFUN_CLOSE
  263.  
  264. EUFUN_2( Fn_int_sref, form, off)
  265. {
  266.   while (!is_string(form))
  267.     form = CallError(stacktop,"Not a string in i-string-ref",form,CONTINUABLE);
  268.   while (typeof(off)!=TYPE_INT)
  269.     off = CallError(stacktop,"Not an integer in i-string-ref",form,CONTINUABLE);
  270.   return allocate_integer(stackbase, (stringof(form))[intval(off)]);
  271. }
  272. EUFUN_CLOSE
  273.  
  274. EUFUN_3( Fn_int_sref_setter, form, off, val)
  275. {
  276.   while (!is_string(form))
  277.     form = CallError(stacktop,"Not a string in set-i-string-ref",form,CONTINUABLE);
  278.   while (typeof(off)!=TYPE_INT)
  279.     off = CallError(stacktop,"Not an integer in set-i-string-ref",form,CONTINUABLE);
  280.   while (!is_fixnum(val))
  281.     off = CallError(stacktop,"Not a fixnum in set-i-string-ref",form,CONTINUABLE);
  282.   stringof(form)[intval(off)] = (char) intval(val);
  283.   return nil;
  284. }
  285. EUFUN_CLOSE
  286.  
  287. EUFUN_3( Fn_substring, str, start, end)
  288. {
  289.   int len;
  290.   int istart;
  291.   int iend;
  292.   while (!is_string(str))
  293.     str = CallError(stacktop,"Not a string in substring",str,CONTINUABLE);
  294.   while (typeof(start)!=TYPE_INT)
  295.     start = CallError(stacktop,"Not an integer in substring",start,CONTINUABLE);
  296.   while (typeof(end)!=TYPE_INT)
  297.     end = CallError(stacktop,"Not an integer in substring",end,CONTINUABLE);
  298.   len = strlen(stringof(str));
  299.   istart = intval(start);
  300.   iend = intval(end);
  301.   if (istart<0 || istart>=len || iend<0 || iend>=len || iend<istart) {
  302.     printf("Illegal arguments to substring\n");
  303.     return nil;
  304.   }
  305.   {
  306.     char buff[256];
  307.     for (len = 0 ; istart<=iend; istart++, len++)
  308.       buff[len] = (stringof(str))[istart];
  309.     buff[len] = '\0';
  310.     return allocate_string(stackbase, buff,len);
  311.   }
  312. }
  313. EUFUN_CLOSE
  314.  
  315. EUFUN_2( Fn_string_append, str1, str2)
  316. {
  317.   int len;
  318.   char buff[256];
  319.  
  320.   while (!is_string(str1))
  321.     str1 = CallError(stacktop,"Not a string in string-append",str1,CONTINUABLE);
  322.   while (!is_string(str2))
  323.     str2 = CallError(stacktop,"Not a string in string-append",str2,CONTINUABLE);
  324.   len = strlen(stringof(str1));
  325.   strcpy(buff,stringof(str1));
  326.   strcpy(buff+len,stringof(str2));
  327.   return allocate_string(stackbase, buff,len+strlen(stringof(str2)));
  328. }
  329. EUFUN_CLOSE
  330.  
  331. /* **  String-operators module ** */
  332. EUFUN_1( Fn_string_list, form)
  333. {
  334.   LispObject ans=nil;
  335.   while (!is_string(form))
  336.     form = CallError(stacktop,"Not a string in string-to-list",form,CONTINUABLE);
  337.   {
  338.     char *str = stringof(form);
  339.     int n;
  340.     for (n= strlen(str)-1; n>=0; n--) {
  341.       LispObject x;
  342.       STACK_TMP(ans);
  343.       x = allocate_char(stacktop, str[n]);
  344.       UNSTACK_TMP(ans);
  345.       ARG_0(stacktop) = x;
  346.       ARG_1(stacktop) = ans;
  347.       ans = Fn_cons(stacktop);
  348.     }
  349.   }
  350.   return ans;
  351. }
  352. EUFUN_CLOSE
  353.  
  354.  
  355. EUFUN_2( Fn_string_equal, str1, str2)
  356. {
  357.   char *ss1;
  358.   char *ss2;
  359.   while (!is_string(str1))
  360.     str1 = CallError(stacktop,"Not a string in string-equal",str1,CONTINUABLE);
  361.   while (!is_string(str2))
  362.     str2 = CallError(stacktop,"Not a string in string-equal",str2,CONTINUABLE);
  363.   ss1 = stringof(str1);
  364.   ss2 = stringof(str2);
  365.   return (strcmp(ss1,ss2)==0 ? lisptrue: nil);
  366. }
  367. EUFUN_CLOSE
  368.  
  369. EUFUN_2( Fn_string_lt, str1, str2)
  370. {
  371.   char *ss1;
  372.   char *ss2;
  373.   while (!is_string(str1))
  374.     str1 = CallError(stacktop,"Not a string in string-lt",str1,CONTINUABLE);
  375.   while (!is_string(str2))
  376.     str2 = CallError(stacktop,"Not a string in string-lt",str2,CONTINUABLE);
  377.   ss1 = stringof(str1);
  378.   ss2 = stringof(str2);
  379.   return (strcmp(ss1,ss2)<0 ? lisptrue: nil);
  380. }
  381. EUFUN_CLOSE
  382.  
  383. EUFUN_2( Fn_string_gt, str1, str2)
  384. {
  385.   char *ss1;
  386.   char *ss2;
  387.   while (!is_string(str1))
  388.     str1 = CallError(stacktop,"Not a string in string-gt",str1,CONTINUABLE);
  389.   while (!is_string(str2))
  390.     str2 = CallError(stacktop,"Not a string in string-gt",str2,CONTINUABLE);
  391.   ss1 = stringof(str1);
  392.   ss2 = stringof(str2);
  393.   return (strcmp(ss1,ss2)>0 ? lisptrue: nil);
  394. }
  395. EUFUN_CLOSE
  396.  
  397. EUFUN_2( Fn_string_le, str1, str2)
  398. {
  399.   char *ss1;
  400.   char *ss2;
  401.   while (!is_string(str1))
  402.     str1 = CallError(stacktop,"Not a string in string-<=",str1,CONTINUABLE);
  403.   while (!is_string(str2))
  404.     str2 = CallError(stacktop,"Not a string in string-<=",str2,CONTINUABLE);
  405.   ss1 = stringof(str1);
  406.   ss2 = stringof(str2);
  407.   return (strcmp(ss1,ss2)<=0 ? lisptrue: nil);
  408. }
  409. EUFUN_CLOSE
  410.  
  411. EUFUN_2( Fn_string_ge, str1, str2)
  412. {
  413.   char *ss1;
  414.   char *ss2;
  415.   while (!is_string(str1))
  416.     str1 = CallError(stacktop,"Not a string in string->=",str1,CONTINUABLE);
  417.   while (!is_string(str2))
  418.     str2 = CallError(stacktop,"Not a string in string->=",str2,CONTINUABLE);
  419.   ss1 = stringof(str1);
  420.   ss2 = stringof(str2);
  421.   return (strcmp(ss1,ss2)>=0 ? lisptrue: nil);
  422. }
  423. EUFUN_CLOSE
  424.  
  425. /* SYMBOLS */
  426.  
  427. EUFUN_1( Fn_symbolp, form)
  428. {
  429.   return (is_symbol(form) ? lisptrue : nil);
  430. }
  431. EUFUN_CLOSE
  432.  
  433. EUFUN_1( Fn_make_symbol, str)
  434. {
  435.   while (!is_string(str))
  436.     str = CallError(stacktop,"Not a string in make-symbol",str,CONTINUABLE);
  437.   return (LispObject) get_symbol_by_copying(stackbase, stringof(str));
  438. }
  439. EUFUN_CLOSE
  440.  
  441. EUFUN_1( Fn_symbolname, form)
  442. {
  443.   while (!is_symbol(form))
  444.     form = CallError(stacktop,"Not symbol in symbol-name",form,CONTINUABLE);
  445.   return allocate_string(stackbase, stringof((form->SYMBOL).pname),strlen(stringof((form->SYMBOL).pname)));
  446. }
  447. EUFUN_CLOSE
  448.  
  449. EUFUN_1( Fn_symbolvalue, form)
  450. {
  451.   while (!is_symbol(form))
  452.     form = CallError(stacktop,"symbol-value: non symbol",form,CONTINUABLE);
  453.   if (form->SYMBOL.gvalue == NULL)
  454.     CallError(stacktop,"symbol-value: globally unbound",form,NONCONTINUABLE);
  455.   return (form->SYMBOL).gvalue;
  456. }
  457. EUFUN_CLOSE
  458.   
  459. EUFUN_2( Fn_symbolvalue_update, form, new)
  460. {
  461.   while (!is_symbol(form))
  462.     form = CallError(stacktop,"symbol-value: non-symbol",form,CONTINUABLE);
  463.   (form->SYMBOL).gvalue = new;
  464.   return nil;
  465. }
  466. EUFUN_CLOSE
  467.   
  468. EUFUN_1( Fn_symbolglobal, form)
  469. {
  470.   while (!is_symbol(form))
  471.     form = CallError(stacktop,"Not symbol in symbol-global",form,CONTINUABLE);
  472.   return (form->SYMBOL).gvalue;
  473. }
  474. EUFUN_CLOSE
  475.   
  476. EUFUN_2( Fn_symbolglobal_update, form, new)
  477. {
  478.   while (!is_symbol(form))
  479.     form = CallError(stacktop,"Not symbol in symbol-global",form,CONTINUABLE);
  480.   (form->SYMBOL).gvalue = new;
  481.   return nil;
  482. }
  483. EUFUN_CLOSE
  484.  
  485. EUFUN_1( Fn_explode, sym)
  486. {
  487.   LispObject list,last;
  488.   char *name;
  489.   char temp[5];
  490.  
  491.   if (!is_symbol(sym))
  492.     CallError(stacktop,"explode: not a symbol",sym,NONCONTINUABLE);
  493.  
  494.   name = stringof(sym->SYMBOL.pname);
  495.   last = list = nil;
  496.  
  497.   while (*name != '\0') {
  498.     LispObject symbit;
  499.  
  500.     temp[0] = *name; temp[1] = '\0';
  501.  
  502.     symbit = get_symbol_by_copying(stackbase, temp);
  503.  
  504.     if (last == nil) {
  505.       ARG_0(stacktop) = symbit;
  506.       ARG_1(stacktop) = nil;
  507.       list = Fn_cons(stacktop);
  508.       last = list;
  509.       STACK_TMP(list);
  510.     }
  511.     else {
  512.       LispObject x;
  513.       STACK_TMP(last);
  514.       ARG_0(stacktop) = symbit;
  515.       ARG_1(stacktop) = last;
  516.       x = Fn_cons(stacktop);
  517.       UNSTACK_TMP(last);
  518.       CDR(last) = x;
  519.       last = x;
  520.     }
  521.  
  522.     ++name;
  523.   }
  524.   UNSTACK_TMP(list);
  525.   return(list);
  526. }
  527. EUFUN_CLOSE
  528.  
  529. EUFUN_2( Fn_make_string, n, rest)
  530. {
  531.   LispObject ch,str;
  532.   int i;
  533.   char cch;
  534.  
  535.   if (consp(rest)) {
  536.     ch = CAR(rest);
  537.  
  538.     if (!is_char(ch))
  539.       CallError(stacktop,"make-string: bad character",ch,NONCONTINUABLE);
  540.  
  541.     cch = (char) (ch->CHAR.code);
  542.   }
  543.   else cch = ' ';
  544.  
  545.   if (!is_fixnum(n))
  546.     CallError(stacktop,"make-string: bad length",n,NONCONTINUABLE);
  547.  
  548.   if (intval(n) < 1)
  549.     CallError(stacktop,"make-string: bad length",n,NONCONTINUABLE);
  550.  
  551.   str = (LispObject) allocate_string(stackbase, "",intval(n));
  552.  
  553.   for (i=0; i<intval(n); ++i) 
  554.     stringof(str)[i] = cch;
  555.  
  556.   stringof(str)[i] = '\0';
  557.  
  558.   return(str);
  559. }
  560. EUFUN_CLOSE
  561.  
  562. static SYSTEM_GLOBAL(int,gensym_counter);
  563.  
  564. EUFUN_0( Fn_gensym)
  565. {
  566.   char buffer[100];
  567.  
  568.   sprintf(buffer,"G%05d\0",SYSTEM_GLOBAL_VALUE(gensym_counter));
  569.   ++SYSTEM_GLOBAL_VALUE(gensym_counter);
  570.  
  571.   return((LispObject) get_symbol_by_copying(stackbase, buffer));
  572. }
  573. EUFUN_CLOSE
  574.  
  575. /* *************************************************************** */
  576. /* This is not part of the real Eulisp definition                  */  
  577. /* *************************************************************** */
  578.  
  579. EUFUN_1( Fn_mapoblist, fn)
  580. {    /* And would not work in any case --- pab */
  581.   LispObject ob = (LispObject) (ObList);
  582.  
  583.  
  584.   while (ob!=NULL) {
  585.     EUCALL_2(apply1, fn, ob);
  586.     ob = ARG_1(stacktop);
  587.     ob = (LispObject) (ob->SYMBOL).left;
  588.   }
  589.   return nil;
  590. }
  591. EUFUN_CLOSE
  592.  
  593. /* *************************************************************** */
  594. /* Initialisation of this section                                  */
  595. /* *************************************************************** */
  596.  
  597. #define STRINGS_ENTRIES 16
  598. MODULE Module_strings;
  599. LispObject Module_strings_values[STRINGS_ENTRIES];
  600.  
  601. #define CHARACTERS_ENTRIES 17
  602. MODULE Module_characters;
  603. LispObject Module_characters_values[CHARACTERS_ENTRIES];
  604.  
  605. #define SYMBOLS_ENTRIES 10
  606. MODULE Module_symbols;
  607. LispObject Module_symbols_values[SYMBOLS_ENTRIES];
  608.  
  609. void initialise_chars(LispObject *stacktop)
  610. {
  611.   LispObject fun,upd;
  612.  
  613.   open_module(stacktop,
  614.           &Module_characters,
  615.           Module_characters_values,
  616.           "characters",
  617.           CHARACTERS_ENTRIES);
  618.  
  619.   (void) make_module_function(stacktop,"characterp",Fn_characterp,1);
  620.   (void) make_module_function(stacktop,"integer-to-character",Fn_int2char,1);
  621.   (void) make_module_function(stacktop,"character-to-integer",Fn_char2int,1);
  622.   (void) make_module_function(stacktop,"char-alphabetic-p",Fn_charalphap,1);
  623.   (void) make_module_function(stacktop,"char-numeric-p",Fn_charnump,1);
  624.   (void) make_module_function(stacktop,"char-whitespace-p",Fn_charwhitep,1);
  625.   (void) make_module_function(stacktop,"char-punctuation-p",Fn_charpuncp,1);
  626.   (void) make_module_function(stacktop,"char-other-p",Fn_charotherp,1);
  627.   (void) make_module_function(stacktop,"char-upper-case-p",Fn_charupperp,1);
  628.   (void) make_module_function(stacktop,"char-lower-case-p",Fn_charlowerp,1);
  629.   (void) make_module_function(stacktop,"char-upcase",Fn_charupper,1);
  630.   (void) make_module_function(stacktop,"char-downcase",Fn_charlower,1);
  631.   (void) make_module_function(stacktop,"char-equal",Fn_chareq,2);
  632.   (void) make_module_function(stacktop,"char<",Fn_charls,2);
  633.   (void) make_module_function(stacktop,"char>",Fn_chargt,2);
  634.   (void) make_module_function(stacktop,"char<=",Fn_charle,2);
  635.   (void) make_module_function(stacktop,"char>=",Fn_charge,2);
  636.  
  637.   close_module();
  638.  
  639.   open_module(stacktop,
  640.           &Module_strings,
  641.           Module_strings_values,
  642.           "strings",
  643.           STRINGS_ENTRIES);
  644.  
  645.   (void) make_module_function(stacktop,"make-string",Fn_make_string,-2);
  646.   (void) make_module_function(stacktop,"stringp",Fn_stringp,1);
  647.   (void) make_module_function(stacktop,"string-length",Fn_string_length,1);
  648.   fun = make_module_function(stacktop,"string-ref",Fn_sref,2);
  649.   STACK_TMP(fun);
  650.   upd = make_module_function(stacktop,"string-ref-updator",Fn_sref_setter,3);
  651.   UNSTACK_TMP(fun);
  652.   set_anon_associate(stacktop,fun,upd);
  653.   fun = make_module_function(stacktop,"i-string-ref",Fn_int_sref,2);
  654.   STACK_TMP(fun);
  655.   upd = make_module_function(stacktop,"i-string-ref-updator",Fn_int_sref_setter,3);
  656.   UNSTACK_TMP(fun);
  657.   (void) make_module_function(stacktop,"string-copy",Fn_string_copy,1);
  658.   (void) make_module_function(stacktop,"string-to-list",Fn_string_list,1);
  659.   (void) make_module_function(stacktop,"string-equal",Fn_string_equal,2);
  660.   (void) make_module_function(stacktop,"string-lt",Fn_string_lt,2);
  661.   (void) make_module_function(stacktop,"string-gt",Fn_string_gt,2);
  662.   (void) make_module_function(stacktop,"substring",Fn_substring,3);
  663.   (void) make_module_function(stacktop,"string-append",Fn_string_append,2);
  664.   (void) make_module_function(stacktop,"string-<=",Fn_string_le,2);
  665.   (void) make_module_function(stacktop,"string->=",Fn_string_ge,2);
  666.  
  667.   close_module();
  668.  
  669.   open_module(stacktop,
  670.           &Module_symbols,
  671.           Module_symbols_values,
  672.           "symbols",
  673.           SYMBOLS_ENTRIES);
  674.  
  675.   (void) make_module_function(stacktop,"symbolp",Fn_symbolp,1);
  676.   (void) make_module_function(stacktop,"make-symbol",Fn_make_symbol,1);
  677.   (void) make_module_function(stacktop,"symbol-name",Fn_symbolname,1);
  678.   fun = make_module_function(stacktop,"symbol-value",Fn_symbolvalue,1);
  679.   STACK_TMP(fun);
  680.   upd = make_module_function(stacktop,"symbol-value-updator",Fn_symbolvalue_update,2);
  681.   UNSTACK_TMP(fun);
  682.   set_anon_associate(stacktop,fun,upd);
  683.   fun = make_module_function(stacktop,"symbol-global",Fn_symbolglobal,1);
  684.   STACK_TMP(fun);
  685.   upd = make_module_function(stacktop,"symbol-global-updator",Fn_symbolglobal_update,2);
  686.   UNSTACK_TMP(fun);
  687.   set_anon_associate(stacktop,fun,upd);
  688.   (void) make_module_function(stacktop,"mapoblist",Fn_mapoblist,1);
  689.   
  690.   (void) make_module_function(stacktop,"explode",Fn_explode,1);
  691.  
  692.   SYSTEM_INITIALISE_GLOBAL(int,gensym_counter,0);
  693.   (void) make_module_function(stacktop,"gensym",Fn_gensym,0);
  694.  
  695.   close_module();
  696. }
  697.  
  698.